home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / Prefs / Prefs.p
Encoding:
Text File  |  1992-11-25  |  4.6 KB  |  166 lines  |  [TEXT/PJMM]
  1. {    Source code for "And Then There Were Preferences" in the Fall 1990 issue    }
  2. {    of THINKin' CaP                                                                         }
  3.  
  4. {        © 1991 Eric Slosser. All rights reserved.                                        }
  5. {        Modified: Jan 92, D.B. Lamkins — editorial changes, System 7 support,    }
  6. {            improved error handling.                                                    }
  7. {        Modified: Nov 92, D.B. Lamkins — set type and creator of new file, get        }
  8. {            rid of hard-coded STR# ID.}
  9.  
  10. unit Prefs;
  11.  
  12. interface
  13.  
  14. {    Pass back the reference number to the preferences file.    }
  15. {    This file is a resource file located in a subfolder of the    }
  16. {    System folder. The names of the subfolder and the        }
  17. {    prefs file are specified in a STR# resource (but for        }
  18. {    System 7 and later, the name of the preferences folder    }
  19. {    is determined by the system, and may vary according    }
  20. {    to localization of the system software).                    }
  21. {    The STR# resource also specifies type and creator for    }
  22. {    a new file.                                                        }
  23. {}
  24. {    This routine will create the prefs file and subfolder if    }
  25. {    necessary.                                                    }
  26. {}
  27. {    The file reference number is -1 if there is an error.        }
  28.     function GetPrefsFileRefNum (prefsInfoID: Integer; var pfRefNum: integer): OSErr;
  29.  
  30. implementation
  31.  
  32.     uses
  33.         Folders;
  34.  
  35.     const
  36.         kPrefsFolderNameIndex = 1;                { prefsInfoID STR# indices }
  37.         kPrefsFileNameIndex = 2;
  38.         kPrefsTypeCreatorIndex = 3;
  39.  
  40.     function myHSetVol (name: StringPtr; vRefNum: integer; WDDirID: longint): OSErr;
  41.         var
  42.             pb: WDPBRec;
  43.     begin
  44.         pb.ioNamePtr := name;
  45.         pb.ioVRefNum := vRefNum;
  46.         pb.ioWDDirID := WDDirID;
  47.         myHSetVol := PBHSetVol(@pb, false);
  48.     end;
  49.  
  50.     function GetPrefsFileRefNum (prefsInfoID: Integer; var pfRefNum: integer): OSErr;
  51.         label
  52.             99;
  53.         var
  54.             err: OSErr;
  55.             fileNotFound: Boolean;
  56.             world: SysEnvRec;
  57.             prefsFolderVRefNum, saved: integer;
  58.             prefsFolderDirID: longint;
  59.             tempString: Str255;
  60.             prefsFolderName, prefsFileName: Str31;
  61.             cpb: CInfoPBRec;
  62.             fndrInfo: FInfo;
  63.     begin
  64.         pfRefNum := -1;    { Setup for a bad return. }
  65.         err := GetVol(nil, saved);    { Remember our starting volume ref. }
  66.  
  67.     { See what system we are running. }
  68.         err := SysEnvirons(curSysEnvVers, world);
  69.         if err <> noErr then
  70.             goto 99;
  71.  
  72.         if world.systemVersion < $0420 then
  73.             goto 99
  74.  
  75.         else if world.systemVersion >= $0700 then
  76.             begin
  77.                 err := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, prefsFolderVRefNum, prefsFolderDirID);
  78.                 if err <> noErr then
  79.                     goto 99;
  80.             end
  81.         else
  82.             begin
  83.         { Get prefs folder name from a STR# resource. }
  84.                 GetIndString(tempString, prefsInfoID, kPrefsFolderNameIndex);
  85.                 prefsFolderName := tempString;
  86.                 if ResError <> noErr then
  87.                     goto 99;
  88.  
  89.         { Start by getting the dirID of the system folder. }
  90.                 cpb.ioNamePtr := nil;
  91.                 cpb.ioVRefNum := world.sysVRefNum;
  92.                 cpb.ioDirID := 0;
  93.                 cpb.ioFDirIndex := -1;
  94.                 err := PBGetCatInfo(@cpb, false);
  95.                 if err <> noErr then
  96.                     goto 99;
  97.  
  98.         { Now ioDir is set to the id of the system folder, so look for prefs folder. }
  99.                 cpb.ioNamePtr := @prefsFolderName;
  100.                 cpb.ioFDirIndex := 0;
  101.                 err := PBGetCatInfo(@cpb, false);
  102.  
  103.         { If prefs folder doesn 't exist, create it. }
  104.                 if err = fnfErr then
  105.                     begin
  106.                         err := PBDirCreate(@cpb, false);
  107.                         if err <> noErr then
  108.                             goto 99;
  109.                     end
  110.                 else if err <> noErr then
  111.                     goto 99;
  112.  
  113.                 prefsFolderVRefNum := cpb.ioVRefNum;
  114.                 prefsFolderDirID := cpb.ioDirID;
  115.             end;
  116.  
  117.     { Get prefs file name from STR# resource. }
  118.         GetIndString(tempString, prefsInfoID, kPrefsFileNameIndex);
  119.         prefsFileName := tempString;
  120.         if ResError <> noErr then
  121.             goto 99;
  122.  
  123.     { Look for the prefs file in the prefs folder. }
  124.         cpb.ioNamePtr := @prefsFileName;
  125.         cpb.ioVRefNum := prefsFolderVRefNum;
  126.         cpb.ioDirID := prefsFolderDirID;
  127.         cpb.ioFDirIndex := 0;
  128.         cpb.ioFVersNum := 0;
  129.  
  130.         err := PBGetCatInfo(@cpb, false);
  131.         fileNotFound := err = fnfErr;
  132.  
  133.     { Temporarily change defaults to the prefs folder. }
  134.         err := myHSetVol(nil, world.sysVRefNum, prefsFolderDirID);
  135.  
  136.     { If prefs file doesn't exist, create it. }
  137.         if fileNotFound then
  138.             begin
  139.                 CreateResFile(prefsFileName);
  140.                 err := ResError;
  141.                 if err = noErr then
  142.                     begin
  143.                         err := GetFInfo(prefsFileName, 0, fndrInfo);
  144.                         GetIndString(tempString, prefsInfoID, kPrefsTypeCreatorIndex);
  145.                         BlockMove(@tempString[1], @fndrInfo.fdType, 2 * SIZEOF(OSType));
  146.                         if err = noErr then
  147.                             err := SetFInfo(prefsFileName, 0, fndrInfo);
  148.                     end;
  149.             end;
  150.  
  151.     { Bail out if CreateResFile failed or error wasn't fnfErr. }
  152.         if err <> noErr then
  153.             goto 99;
  154.  
  155.     { Open the prefs file. }
  156.         pfRefNum := OpenResFile(prefsFileName);
  157.  
  158. 99:
  159.     { Change default back to saved. }
  160.         err := SetVol(nil, saved);
  161.  
  162.         GetPrefsFileRefNum := err;
  163.  
  164.     end; { GetPrefsFileRefNum }
  165.  
  166. end.